home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0920.ZIP / READEN.ARC / READENV.PAS < prev   
Pascal/Delphi Source File  |  1987-12-25  |  7KB  |  201 lines
  1. Program Read_Environment_Variables;
  2. { Program function:
  3.   1. read variables in the DOS environment and print a list
  4.   2. locate one variable: 'PATH'.
  5.   3. store the contents of each directory (delimited by a ';')
  6.      in an array
  7.   4. print the contents of the array
  8.  
  9.       Program limitations:
  10.       1. Requires DOS 3.0 or later for procedure Get_PSP.
  11.       2. Environment space: 32K bytes max
  12.          Path variable: 1K bytes max.
  13.       3. Does not read lowercase chars if in the path (byte values 97..122).      
  14. }
  15.  
  16. { Downloaded 12/19/87 from cis:bproga:dl4 TPascal V3.0 code
  17.    6/21/87        John T. McCann       Compuserve ID [72617,710]
  18.        Programmer for Integrity Software, we make network utilities
  19.                                           for Novell Netware Networks
  20.    12/24/87       Michael Shunfenthal  Compuserve ID [76320,122]
  21.       Added from original 6/21/87:
  22.       1. upgrade to V4.0
  23.       2. prints additional error message
  24.       3. rearranged and added procedures to modularize funtions
  25.       Remove bugs:
  26.       1. able to display more than one screen
  27.       2. find PATH when it is the first variable in the environment
  28.       3. ignore PATH even if part of the name of another var, like BPATH
  29. }
  30.  
  31. Uses
  32.   Crt, Dos;
  33.  
  34. Const
  35.   TotalPaths = 20;        { max number of directories in the path }
  36.  
  37. var
  38.    Segment,               { the two parts of an address }
  39.    offset,
  40.    offsetvarstart,        { offset wher the 'P' in PATH... begins }
  41.    pc,                    { when searching: character-in-path counter }
  42.    pcl     : Integer;     { when searching: number-of-directories counter }
  43.    Paths   : Array[1..TotalPaths] of Array[1..255] of Byte;
  44.  
  45.  
  46. Procedure Get_PSP; { get the program segment prefix }
  47. var
  48.    Regs                 : Registers;
  49.    PSP                  : Integer;
  50.  
  51. Begin
  52.    Regs.AX :=  $6200;         { Get PSP address    }
  53.    MsDos(Regs);               { Call DOS, int 0x21 }
  54.    PSP := Regs.BX;            { BX has our PSP     }
  55.    Segment := MemW[PSP:$2C];  { the offset of $2C indicates the starting
  56.                                place in memory of our current environment
  57.                                string }
  58.  
  59. End; { Get_PSP }
  60.  
  61. Procedure Read_Env;
  62. { read the environment area, searching for variables delimited by a null }
  63.  
  64. procedure locatevariable;
  65. { search for the specified variable: 'PATH'}
  66.  
  67. begin
  68. { parse argument, process search sequentially }
  69.    if (Mem[Segment:offset] = ord('P'))    and
  70.       (Mem[Segment:offset+1] = ord('A'))  and
  71.       (Mem[Segment:offset+2] = ord('T'))  and
  72.       (Mem[Segment:offset+3] = ord('H'))
  73.          then
  74.             offsetvarstart:=offset;   { mark where variable begins in memory }
  75. end; { locatevariable }
  76.  
  77. Begin { Read_Env }
  78.    offset := -1;              { set initial offsets }
  79.    offsetvarstart := -1;
  80.    TextColor(7);
  81.    ClrScr;
  82.    Writeln('The DOS environment variables');
  83.    TextColor(3);
  84.    While (offset < 32000) do   { stop after reading the first 1000
  85.                                 characters of the DOS environment }
  86.       begin
  87.          offset := offset + 1;   { increment the offset by one             }
  88.          { call locatevariable to see if it is the first variable
  89.            in the environment }
  90.          if offset = 0 then locatevariable;
  91.          if Mem[Segment:offset] = 0  then
  92.             begin
  93.                if Mem[Segment:offset+1] = 0 then
  94.                   begin
  95.             { two nulls in a row indicate the end of the environment.  }
  96.             TextColor(9);
  97.             writeln(#10#10#13'The DOS environment is ',offset,' bytes long.',
  98.                '  PATH located at offset: ', offsetvarstart);
  99.             exit
  100.                   end
  101.                else     { a single null indicates the end of one variable,
  102.                           so the call to locatevariable will not find one
  103.                           as part of another }
  104.                   begin
  105.                      offset := offset + 1;
  106.                      locatevariable;
  107.                      offset := offset - 1;
  108.                      writeln;
  109.                   end
  110.             end
  111.          else  { not a null }
  112.             begin
  113.             write(chr(Mem[Segment:offset])); { print any value but 0 (null) }
  114.             end
  115.   End;  { end while loop }
  116. End;  { Read_Env }
  117.  
  118. Procedure StorePath;
  119. { search for each directory delimited by a ';' and store it in an array }
  120.  
  121. var
  122.    Newoff : integer;
  123.  
  124. Begin                 { initialize the array to nulls }
  125.    for pc:=1 to TotalPaths do FillChar(paths,255,0);
  126.    pc  := 0;
  127.    pcl := 1;
  128. {
  129.    Found PATH= thus first 5 bytes are PATH= so skip it, then parse by ;
  130. }
  131.    Newoff := offsetvarstart+5;   { see skip message above }
  132.    While Newoff< offsetvarstart+1000 do  { presuming PATH is smaller than 1000 chars }
  133.     begin
  134.       if Mem[Segment:NewOff]=0 then
  135.          Newoff:=offsetvarstart+1024        { null found, so PATH Search is Complete }
  136.       else
  137.       if Mem[Segment:Newoff] in [33..41,44..59,61,64..90,92] then
  138.                                    { are they allowable directory chars?  }
  139.       if Mem[Segment:Newoff] in [59] then { [59] is the ';', the PATH delim }
  140.          begin                             { end of one subdirectory }
  141.           if pcl = TotalPaths then
  142.             begin
  143.               writeln('Too many Paths encountered... exiting');
  144.               Halt(1);               { return to DOS with ErrorLevel set to 1 }
  145.             end;
  146.           pc := 0; pcl := pcl+1;     { reset char, increment directory counts }
  147.          end
  148.        else
  149.          begin                       { save the path character in an array }
  150.           pc := pc+1;
  151.           paths[pcl][pc]:=Mem[Segment:Newoff];
  152.          end;
  153.       Newoff := Newoff + 1;
  154.      end;
  155. end; { StorePath }
  156.  
  157. Procedure ListPath;
  158.           { display each directory in the path }
  159. var
  160.    a,                 { when displaying: character-in-path counter }
  161.    b : integer;       { when displaying: number-of-directories counter }
  162.  
  163. begin
  164. TextColor(12);
  165. writeln;
  166. writeln('Number of directories: ', pcl, '.  Your current path is:');
  167. Textcolor(5);             { print each directory in the path on a new line }
  168. If pcl > 1
  169.    Then
  170.       For a:=1 to pcl do   { a counts directories in the array }
  171.         begin
  172.           b:=1;            { b counts characters (first index) in the array }
  173.           While b < 255 do
  174.              if paths[a][b] in [32..95] then
  175.                 begin
  176.                   { it is a printable char }
  177.                    write(chr(paths[a][b]));
  178.                    b:=b+1;
  179.                 end
  180.              else          { it is NOT printable...        }
  181.                 b:=256;    { something greater than 255 to get us out of while }
  182.           writeln; { a new line }
  183.        end { of for loop }
  184.    else
  185.       Writeln('No PATHs in current environment');
  186. end;  { ListPath }
  187.  
  188. Begin            { of main program }
  189.    Get_PSP;
  190.    Read_Env;
  191.    if offsetvarstart > -1 then
  192.       begin      { if offsetvarstart has not been changed from its initial }
  193.          StorePath; { setting to -1, then the variable has not been found }
  194.          ListPath;
  195.       end
  196.    else
  197.       writeln ('No path found');
  198. End.             { of main program }
  199.  
  200.  
  201.